home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DEMO / SIEVE.M < prev    next >
Encoding:
Text File  |  1990-12-10  |  1.2 KB  |  60 lines
  1. MODULE Sieve;
  2.  
  3. (*
  4.  * Dies ist ein aus der C-Welt übliches Geschwindigkeits-Demo-Programm.
  5.  *
  6.  * Achtung: Vor dem Start muß der Stack (für Loadtime-Linking, in den
  7.  * Umgebungsinformationen) auf mind. 20000 gesetzt werden! Wird das
  8.  * vergessen, stürzt das System ab, weil die Stack-Platz-Prüfung
  9.  * hier extra abgeschaltet ist.
  10.  *)
  11.  
  12. (*$S-,R-*)
  13.  
  14. IMPORT TOSIO; (*$E MOS *)
  15.  
  16. FROM InOut  IMPORT  Read, Write, WriteString, WriteCard, WriteLn;
  17.  
  18. CONST Size = 8190;
  19.       Iter = 100;  (* Anzahl der Durchläufe *)
  20.  
  21. PROCEDURE oneSieve;
  22.  
  23.   VAR         flag: ARRAY [0..Size] OF BOOLEAN;
  24.               j,
  25.     (*$Reg*)  k,
  26.     (*$Reg*)  count,
  27.     (*$Reg*)  prime: CARDINAL;
  28.   
  29.   BEGIN
  30.     count := 0;
  31.     FOR j := 0 TO Size DO
  32.       flag[j] := TRUE;
  33.     END;
  34.     FOR j := 0 TO Size DO
  35.       IF flag[j] THEN
  36.         prime := j+j+3;
  37.         k := j+prime;
  38.         WHILE k <= Size DO
  39.           flag[k] := FALSE;
  40.           INC (k, prime);
  41.         END;
  42.         INC (count);
  43.       END;
  44.     END;
  45.   END oneSieve;
  46.  
  47. VAR ch: CHAR;
  48.     i: CARDINAL;
  49.  
  50. BEGIN
  51.   WriteString ("Taste zum Starten...");
  52.   Read (ch);
  53.   WriteLn;
  54.   FOR i:= 1 TO Iter DO
  55.     oneSieve
  56.   END;
  57.   Write (7C);
  58.   WriteString ("Fertig.")
  59. END Sieve.
  60.